home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / heap55.com / BADPTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-07  |  2.8 KB  |  102 lines
  1. {*****************************************************************************
  2.  This unit automatically checks for attempts to dereference a nil pointer, or
  3.  any pointer which points outside of the normal Turbo heap (below HeapOrg, or
  4.  above the free list). USE it early, perhaps first, in your USES statement. In
  5.  order for this unit to have an effect, the program it is used in must be
  6.  compiled with a copy of TPC patched by HEAPPAT, and the $P+ compiler
  7.  directive must be specified before each section of source code where checking
  8.  is to occur.
  9.  
  10.  For further information, refer to HEAP.DOC.
  11.  
  12.  Written 7/26/88, Kim Kokkonen, TurboPower Software.
  13.  Compuserve ID 76004,2611
  14.  Copyright (C) TurboPower Software, 1988,1989,1990. All rights reserved.
  15.  
  16.  Version 5.0 3/8/89
  17.    Updated for Turbo Pascal 5.0.
  18.  Version 5.5 1/6/90
  19.    Updated for Turbo Pascal 5.5.
  20. *****************************************************************************}
  21.  
  22. {$R-,S-}
  23.  
  24. unit BadPtr;
  25.  
  26. interface
  27.  
  28. uses
  29.   Dos;
  30.  
  31. const
  32.   DerefInterrupt = $66;           {Change this constant if HPAT55 has been
  33.                                    changed to use a different interrupt number}
  34.  
  35. var
  36.   HeapBot : Word;                 {Lowest segment of heap}
  37.   HeapTop : Word;                 {Highest segment of heap}
  38.  
  39.   {============================================================}
  40.  
  41. implementation
  42.  
  43. const
  44.   Digits : array[0..$F] of Char = '0123456789ABCDEF';
  45.  
  46. type
  47.   SO = record
  48.          O, S : Word;
  49.        end;
  50.  
  51. var
  52.   SaveExit : Pointer;             {Previous exit handler}
  53.   SaveDerefInt : Pointer;         {Previous value of int 66 vector}
  54.   BadP : Pointer;                 {Contains bad pointer if error}
  55.  
  56.   function HexW(W : Word) : string;
  57.     {-Return hex string for word}
  58.   begin
  59.     HexW[0] := #4;
  60.     HexW[1] := Digits[hi(W) shr 4];
  61.     HexW[2] := Digits[hi(W) and $F];
  62.     HexW[3] := Digits[lo(W) shr 4];
  63.     HexW[4] := Digits[lo(W) and $F];
  64.   end;
  65.  
  66.   function HexPtr(P : Pointer) : string;
  67.     {-Return hex string for pointer}
  68.   begin
  69.     HexPtr := HexW(SO(P).S)+':'+HexW(SO(P).O);
  70.   end;
  71.  
  72.   procedure BadPointer;
  73.     {-Called when a pointer error is detected}
  74.   begin
  75.     WriteLn('Bad pointer (', HexPtr(BadP), ') encountered at ', HexPtr(ErrorAddr));
  76.     WriteLn('Valid heap limits are ', HexW(HeapBot), '-', HexW(HeapTop));
  77.     Halt(1);
  78.   end;
  79.  
  80.   {$L BADPTR}
  81.   procedure CheckBad;
  82.     {-Check for a bad pointer}
  83.   external;
  84.  
  85.   {$F+}
  86.   procedure Cleanup;
  87.     {-Restore interrupt}
  88.   begin
  89.     ExitProc := SaveExit;
  90.     SetIntVec(DerefInterrupt, SaveDerefInt);
  91.   end;
  92.   {$F-}
  93.  
  94. begin
  95.   HeapBot := SO(HeapOrg).S;
  96.   HeapTop := SO(FreePtr).S+$1000;
  97.   GetIntVec(DerefInterrupt, SaveDerefInt);
  98.   SetIntVec(DerefInterrupt, @CheckBad);
  99.   SaveExit := ExitProc;
  100.   ExitProc := @Cleanup;
  101. end.
  102.